home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
tcl
/
tclm_1_0.lha
/
tclm-1.0
/
tclmCmd.c
< prev
next >
Wrap
C/C++ Source or Header
|
1993-08-16
|
55KB
|
2,143 lines
/*-
* Copyright (c) 1993 Michael B. Durian. All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. All advertising materials mentioning features or use of this software
* must display the following acknowledgement:
* This product includes software developed by Michael B. Durian.
* 4. The name of the the Author may be used to endorse or promote
* products derived from this software without specific prior written
* permission.
*
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
* OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
* IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
*/
/*
* tclmCmd.c,v 1.14 1993/05/07 17:45:07 durian Exp
*/
static char cvsid[] = "tclmCmd.c,v 1.14 1993/05/07 17:45:07 durian Exp";
#include "tclInt.h"
#include "tclUnix.h"
#include "patchlevel.h"
#include "mutil.h"
#include "tclm.h"
#ifdef MIDIPLAY
#include "tclmPlay.h"
#endif
Tcl_HashTable MidiFileHash;
static int mfileId = 0;
static char *key_strings[] = {"C flat", "G flat", "D flat", "A flat",
"E flat", "B flat", "F", "C", "G", "D", "A", "E", "B", "F sharp",
"C sharp"};
static char *event_list = "channelpressure keypressure \"a meta event\" \
noteoff noteon parameter pitchwheel program sysex";
static char *meta_events = "metachanprefix metacpy metacue metaeot \
metainstname metakey metalyric metamarker metaseqname metaseqnum metaseqspec \
metasmpte metatempo metatext metatime";
static int Tclm_ConvertMeta _ANSI_ARGS_((Tcl_Interp *, int, char **,
unsigned char *, int *));
static int Tclm_ConvertTiming _ANSI_ARGS_((Tcl_Interp *, char *,
unsigned char *, int *));
static int Tclm_ConvertBytes _ANSI_ARGS_((Tcl_Interp *, char *,
unsigned char *, int *));
static int Tclm_AddMetaBytes _ANSI_ARGS_((Tcl_Interp *, unsigned char *, int *,
char *));
static void Tclm_AddMetaString _ANSI_ARGS_((unsigned char *, int *, char *));
static void Tclm_MakeMetaText _ANSI_ARGS_((Tcl_Interp *, unsigned char *));
void
Tclm_InitMidi(interp)
Tcl_Interp *interp;
{
Tcl_CreateCommand(interp, "midiconfig", Tclm_MidiConfig, NULL, NULL);
Tcl_CreateCommand(interp, "midiread", Tclm_MidiRead, NULL, NULL);
Tcl_CreateCommand(interp, "midiwrite", Tclm_MidiWrite, NULL, NULL);
Tcl_CreateCommand(interp, "midimerge", Tclm_MidiMerge, NULL, NULL);
Tcl_CreateCommand(interp, "midimake", Tclm_MidiMake, NULL, NULL);
Tcl_CreateCommand(interp, "midifree", Tclm_MidiFree, NULL, NULL);
Tcl_CreateCommand(interp, "midirewind", Tclm_MidiRewind, NULL, NULL);
Tcl_CreateCommand(interp, "midifixtovar", Tclm_MidiFixToVar, NULL,
NULL);
Tcl_CreateCommand(interp, "midivartofix", Tclm_MidiVarToFix, NULL,
NULL);
Tcl_CreateCommand(interp, "midiget", Tclm_MidiGet, NULL, NULL);
Tcl_CreateCommand(interp, "midiput", Tclm_MidiPut, NULL, NULL);
Tcl_CreateCommand(interp, "miditiming", Tclm_MidiTiming, NULL, NULL);
Tcl_CreateCommand(interp, "midiplayable", Tclm_MidiPlayable, NULL,
NULL);
Tcl_CreateCommand(interp, "tclmversion", Tclm_TclmVersion, NULL, NULL);
Tcl_InitHashTable(&MidiFileHash, TCL_ONE_WORD_KEYS);
#ifdef MIDIPLAY
Tclm_InitPlay(interp);
#endif
}
int
Tclm_MidiConfig(dummy, interp, argc, argv)
ClientData dummy;
Tcl_Interp *interp;
int argc;
char **argv;
{
int length;
int result;
/*
* argv[0] - midiconfig
* argv[1] - mfileID
* argv[2] - format | division | tracks
* argv[3] - optional arg
*/
result = TCL_OK;
if (argc < 3 || argc > 4) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], "mfileId {format | division | tracks} ?arg?\"",
(char *)NULL);
return (TCL_ERROR);
}
length = strlen(argv[2]);
switch(argv[2][0]) {
case 'd':
if (strncmp(argv[2], "division", length) == 0)
result = Tclm_Division(interp, argc, argv);
else {
Tcl_AppendResult(interp, "bad option, ", argv[2],
", must be one of format, division or tracks",
(char *)NULL);
return (TCL_ERROR);
}
break;
case 'f':
if (strncmp(argv[2], "format", length) == 0)
result = Tclm_Format(interp, argc, argv);
else {
Tcl_AppendResult(interp, "bad option, ", argv[2],
", must be one of format, division or tracks",
(char *)NULL);
return (TCL_ERROR);
}
break;
case 't':
if (strncmp(argv[2], "tracks", length) == 0)
result = Tclm_NumTracks(interp, argc, argv);
else {
Tcl_AppendResult(interp, "bad option, ", argv[2],
", must be one of format, division or tracks",
(char *)NULL);
return (TCL_ERROR);
}
break;
default:
Tcl_AppendResult(interp, "bad option, ", argv[2],
", must be one of format, division or tracks",
(char *)NULL);
return (TCL_ERROR);
}
return (result);
}
int
Tclm_MidiMake(dummy, interp, argc, argv)
ClientData dummy;
Tcl_Interp *interp;
int argc;
char **argv;
{
MIDI_FILE *mfile;
Tcl_HashEntry *hash_entry;
int created_hash;
/*
* argv[0] - midimake
*/
if (argc != 1) {
Tcl_AppendResult(interp, "bad # args: should be \"",
argv[0], "\"", (char *)NULL);
return (TCL_ERROR);
}
if ((mfile = (MIDI_FILE *)malloc(sizeof(MIDI_FILE))) == NULL) {
Tcl_AppendResult(interp, "Not enough memory for MIDI file",
(char *)NULL);
return (TCL_ERROR);
}
strncpy(mfile->hchunk.str, "MThd", 4);
mfile->hchunk.length = 6;
mfile->hchunk.format = 1;
mfile->hchunk.division = 120;
mfile->hchunk.num_trks = 0;
mfile->tchunks = NULL;
hash_entry = Tcl_CreateHashEntry(&MidiFileHash, (char *)mfileId,
&created_hash);
if (!created_hash) {
Tcl_AppendResult(interp, "Hash bucket for file alread ",
"exists", (char *)NULL);
return (TCL_ERROR);
}
Tcl_SetHashValue(hash_entry, mfile);
sprintf(interp->result, "mfile%d", mfileId++);
return (TCL_OK);
}
int
Tclm_MidiRead(dummy, interp, argc, argv)
ClientData dummy;
Tcl_Interp *interp;
int argc;
char **argv;
{
MIDI_FILE *mfile;
OpenFile *filePtr;
Tcl_HashEntry *hash_entry;
int created_hash;
int fd;
int i;
int result;
char num_str[20];
/*
* argv[0] - midiread
* argv[1] - open file descriptor
*/
if (argc != 2) {
Tcl_AppendResult(interp, "bad # args: should be \"",
argv[0], " fileId\"", (char *)NULL);
return (TCL_ERROR);
}
if ((result = TclGetOpenFile(interp, argv[1], &filePtr)) != TCL_OK)
return (result);
fd = fileno(filePtr->f);
if ((mfile = (MIDI_FILE *)malloc(sizeof(MIDI_FILE))) == NULL) {
Tcl_AppendResult(interp, "Not enough memory for MIDI file",
(char *)NULL);
return (TCL_ERROR);
}
if (!read_header_chunk(fd, &mfile->hchunk)) {
if (MidiEof)
Tcl_AppendResult(interp, "EOF");
else
Tcl_AppendResult(interp,
"Couldn't read header chunk\n", MidiError,
(char *)NULL);
return (TCL_ERROR);
}
if ((mfile->tchunks = (TCHUNK *)malloc(mfile->hchunk.num_trks *
sizeof(TCHUNK))) == NULL) {
Tcl_AppendResult(interp, "Not enough memory for track ",
"chunks", (char *)NULL);
return (TCL_ERROR);
}
for (i = 0; i < mfile->hchunk.num_trks; i++) {
if (!read_track_chunk(fd, &(mfile->tchunks[i]))) {
sprintf(num_str, "%d", i);
Tcl_AppendResult(interp, "Couldn't read track ",
"number ", num_str, "\n", MidiError,
(char *)NULL);
return (TCL_ERROR);
}
}
hash_entry = Tcl_CreateHashEntry(&MidiFileHash, (char *)mfileId,
&created_hash);
if (!created_hash) {
Tcl_AppendResult(interp, "Hash bucket for file alread ",
"exists", (char *)NULL);
return (TCL_ERROR);
}
Tcl_SetHashValue(hash_entry, mfile);
sprintf(interp->result, "mfile%d", mfileId++);
return (TCL_OK);
}
int
Tclm_MidiWrite(dummy, interp, argc, argv)
ClientData dummy;
Tcl_Interp *interp;
int argc;
char **argv;
{
MIDI_FILE *mfile;
OpenFile *filePtr;
int fd;
int i;
int result;
/*
* argv[0] - midiwrite
* argv[1] - mfileId
* argv[2] - fileId
*/
if (argc != 3) {
Tcl_AppendResult(interp, "bad # args: shoudl be \"",
argv[0], " mfileId fileId\"", (char *)NULL);
return (TCL_ERROR);
}
if ((result = TclGetOpenFile(interp, argv[2], &filePtr)) != TCL_OK)
return (result);
if ((result = Tclm_GetMFile(interp, argv[1], &mfile)) != TCL_OK)
return (result);
fd = fileno(filePtr->f);
if (!write_header_chunk(fd, &mfile->hchunk)) {
Tcl_AppendResult(interp, "Couldn't write header chunk\n",
MidiError, (char *)NULL);
return (TCL_ERROR);
}
for (i = 0; i < mfile->hchunk.num_trks; i++) {
if (!write_track_chunk(fd, &(mfile->tchunks[i]))) {
sprintf(interp->result,
"Coudln't write track chunk %d\n%s", i,
MidiError);
return (TCL_ERROR);
}
}
return (TCL_OK);
}
int
Tclm_MidiMerge(dummy, interp, argc, argv)
ClientData dummy;
Tcl_Interp *interp;
int argc;
char **argv;
{
char **strs;
char **substrs;
MIDI_FILE *outmfile;
MIDI_FILE **inmfile;
TCHUNK **intrack;
TCHUNK *outtrack;
int *tscalar;
char *chk_ptr;
int delta;
int endtime;
int i;
int ind;
int numin;
int num_strs;
int num_substrs;
int result;
/*
* argv[0] - midimerge
* argv[1] - {outmfile outtrack}
* argv[2] - {{inmfile intrack tscalar} {inmfile intrack tscalar} ...}
* argv[3] - delta
*/
if (argc != 4) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " {outmfile outtrack} {{inmfile intrack} ",
"{inmfile intrack} ...} delta", (char *)NULL);
return (TCL_ERROR);
}
/* parse output fields */
if ((result = Tcl_SplitList(interp, argv[1], &num_strs, &strs)) !=
TCL_OK)
return (result);
if (num_strs != 2) {
Tcl_AppendResult(interp, "bad track designation: ",
argv[1], (char *)NULL);
return (TCL_ERROR);
}
if ((result = Tclm_GetMFile(interp, strs[0], &outmfile)) != TCL_OK)
return (result);
ind = (int)strtol(strs[1], &chk_ptr, 0);
if (chk_ptr == strs[1] || ind < 0 || ind > outmfile->hchunk.num_trks) {
Tcl_AppendResult(interp, "bad outtrack value: ", strs[1],
(char *)NULL);
return (TCL_ERROR);
}
free((char *)strs);
outtrack = &outmfile->tchunks[ind];
/* now parse input strs */
if ((result = Tcl_SplitList(interp, argv[2], &num_strs, &strs)) !=
TCL_OK)
return (result);
numin = num_strs;
if ((inmfile = (MIDI_FILE **)malloc(sizeof(MIDI_FILE *) * numin))
== NULL) {
Tcl_AppendResult(interp, "Not enough memory for infiles",
(char *)NULL);
free((char *)strs);
return (TCL_ERROR);
}
if ((tscalar = (int *)malloc(sizeof(int) * numin)) == NULL) {
Tcl_AppendResult(interp, "Not enough memory for tscalars",
(char *)NULL);
free((char *)strs);
free((char *)inmfile);
return (TCL_ERROR);
}
if ((intrack = (TCHUNK **)malloc(sizeof(TCHUNK *) * numin)) == NULL) {
Tcl_AppendResult(interp, "Not enough memory for intracks",
(char *)NULL);
free((char *)strs);
free((char *)inmfile);
free((char *)tscalar);
return (TCL_ERROR);
}
for (i = 0; i < numin; i++) {
/* parse each input pair */
if ((result = Tcl_SplitList(interp, strs[i], &num_substrs,
&substrs)) != TCL_OK) {
free((char *)strs);
free((char *)inmfile);
free((char *)tscalar);
free((char *)intrack);
return (result);
}
if (num_substrs != 3) {
Tcl_AppendResult(interp, "bad track designation: ",
strs[i], (char *)NULL);
free((char *)strs);
free((char *)inmfile);
free((char *)tscalar);
free((char *)intrack);
return (TCL_ERROR);
}
if ((result = Tclm_GetMFile(interp, substrs[0], &inmfile[i]))
!= TCL_OK) {
free((char *)strs);
free((char *)inmfile);
free((char *)tscalar);
free((char *)intrack);
return (result);
}
ind = (int)strtol(substrs[1], &chk_ptr, 0);
if (chk_ptr == substrs[1] || ind < 0 ||
ind > inmfile[i]->hchunk.num_trks) {
Tcl_AppendResult(interp, "bad outtrack value: ",
substrs[1], (char *)NULL);
free((char *)strs);
free((char *)inmfile);
free((char *)tscalar);
free((char *)intrack);
free((char *)substrs);
return (TCL_ERROR);
}
intrack[i] = &inmfile[i]->tchunks[ind];
tscalar[i] = (int)strtol(substrs[2], &chk_ptr, 0);
if (chk_ptr == substrs[2]) {
Tcl_AppendResult(interp, "bad tscalar value: ",
substrs[2], (char *)NULL);
free((char *)strs);
free((char *)inmfile);
free((char *)tscalar);
free((char *)intrack);
free((char *)substrs);
return (TCL_ERROR);
}
free((char *)substrs);
}
free((char *)strs);
delta = (int)strtol(argv[3], &chk_ptr, 0);
if (chk_ptr == argv[3]) {
Tcl_AppendResult(interp, "bad delta value: ", argv[3],
(char *)NULL);
free((char *)inmfile);
free((char *)tscalar);
free((char *)intrack);
return (TCL_ERROR);
}
if ((endtime = merge_tracks(outtrack, intrack, tscalar, numin, delta))
== -1) {
Tcl_AppendResult(interp, "Couldn't merge files\n",
MidiError, (char *)NULL);
free((char *)inmfile);
free((char *)tscalar);
free((char *)intrack);
return (TCL_ERROR);
}
sprintf(interp->result, "%d", endtime);
free((char *)inmfile);
free((char *)tscalar);
free((char *)intrack);
return (TCL_OK);
}
int
Tclm_MidiFree(dummy, interp, argc, argv)
ClientData dummy;
Tcl_Interp *interp;
int argc;
char **argv;
{
MIDI_FILE *mfile;
int mfileId;
int result;
/*
* argv[0] - midifree
* argv[1] - mfileId
*/
if (argc != 2) {
Tcl_AppendResult(interp, "bad # args: should be \"",
argv[0], " mfileId\"", (char *)NULL);
return (TCL_ERROR);
}
if ((result = Tclm_GetMFile(interp, argv[1], &mfile)) != TCL_OK)
return (result);
mfileId = (int)strtol(argv[1] + 5, NULL, 0);
Tcl_DeleteHashEntry(Tcl_FindHashEntry(&MidiFileHash, (char *)mfileId));
free(mfile->tchunks);
free(mfile);
return (TCL_OK);
}
int
Tclm_GetMFile(interp, FileId, mfile)
Tcl_Interp *interp;
char *FileId;
MIDI_FILE **mfile;
{
Tcl_HashEntry *hash_entry;
char *chk_ptr;
int mfileId;
if (strncmp(FileId, "mfile", 5) != 0) {
Tcl_AppendResult(interp, "Bad MIDI file identifier \"",
FileId, "\"", (char *)NULL);
return (TCL_ERROR);
}
mfileId = (int)strtol(FileId + 5, &chk_ptr, 0);
if (chk_ptr == FileId + 5) {
Tcl_AppendResult(interp, "Bad MIDI file identifier \"",
FileId, "\"", (char *)NULL);
return (TCL_ERROR);
}
if ((hash_entry = Tcl_FindHashEntry(&MidiFileHash, (char *)mfileId))
== NULL) {
Tcl_AppendResult(interp, FileId, " doesn't exist",
(char *)NULL);
return (TCL_ERROR);
}
*mfile = (MIDI_FILE *)Tcl_GetHashValue(hash_entry);
return (TCL_OK);
}
int
Tclm_SetMFile(interp, FileId, mfile)
Tcl_Interp *interp;
char *FileId;
MIDI_FILE *mfile;
{
Tcl_HashEntry *hash_entry;
char *chk_ptr;
int mfileId;
if (strncmp(FileId, "mfile", 5) != 0) {
Tcl_AppendResult(interp, "Bad MIDI file identifier \"",
FileId, "\"", (char *)NULL);
return (TCL_ERROR);
}
mfileId = (int)strtol(FileId + 5, &chk_ptr, 0);
if (chk_ptr == FileId + 5) {
Tcl_AppendResult(interp, "Bad MIDI file identifier \"",
FileId, "\"", (char *)NULL);
return (TCL_ERROR);
}
if ((hash_entry = Tcl_FindHashEntry(&MidiFileHash, (char *)mfileId))
== NULL) {
Tcl_AppendResult(interp, FileId, " doesn't exist",
(char *)NULL);
return (TCL_ERROR);
}
Tcl_SetHashValue(hash_entry, (char *)mfile);
return (TCL_OK);
}
int
Tclm_NumTracks(interp, argc, argv)
Tcl_Interp *interp;
int argc;
char **argv;
{
MIDI_FILE *mfile;
char *chk_ptr;
int i;
int result;
int num_trks;
/*
* argv[0] - midiconfig
* argv[1] - mfileId
* argv[2] - tracks
* argv[3] - optional number of tracks
*/
if ((result = Tclm_GetMFile(interp, argv[1], &mfile)) != TCL_OK)
return (result);
if (argc == 3)
sprintf(interp->result, "%d", mfile->hchunk.num_trks);
else {
num_trks = (int)strtol(argv[3], &chk_ptr, 0);
if (chk_ptr == argv[3]) {
Tcl_AppendResult(interp, "Bad number of tracks ",
argv[3], (char *)NULL);
return (TCL_ERROR);
}
if (mfile->hchunk.format == 0 && num_trks > 1) {
Tcl_AppendResult(interp, "Format 0 files can only ",
"have zero or one tracks, not ", argv[3],
(char *)NULL);
return (TCL_ERROR);
}
if (mfile->tchunks == NULL) {
if (num_trks != 0) {
if ((mfile->tchunks = (TCHUNK *)malloc(
sizeof(TCHUNK) * num_trks)) == NULL) {
Tcl_AppendResult(interp,
"Not enough memory for ", argv[3],
" tracks", (char *)NULL);
}
}
} else {
if (num_trks == 0) {
free((char *)mfile->tchunks);
mfile->tchunks = NULL;
} else {
if ((mfile->tchunks = (TCHUNK *)realloc(
mfile->tchunks, sizeof(TCHUNK) * num_trks))
== NULL) {
Tcl_AppendResult(interp,
"Not enough memory for ", argv[3],
" tracks", (char *)NULL);
}
}
}
for (i = mfile->hchunk.num_trks; i < num_trks; i++)
init_track(&mfile->tchunks[i]);
mfile->hchunk.num_trks = num_trks;
if ((result = Tclm_SetMFile(interp, argv[1], mfile)) !=
TCL_OK)
return (result);
}
return (TCL_OK);
}
int
Tclm_Format(interp, argc, argv)
Tcl_Interp *interp;
int argc;
char **argv;
{
MIDI_FILE *mfile;
char *chk_ptr;
int result;
int format;
/*
* argv[0] - midiconfig
* argv[1] - mfileId
* argv[2] - format
* argv[3] - optional arg
*/
if ((result = Tclm_GetMFile(interp, argv[1], &mfile)) != TCL_OK)
return (result);
if (argc == 3)
sprintf(interp->result, "%d", mfile->hchunk.format);
else {
format = (int)strtol(argv[3], &chk_ptr, 0);
if (chk_ptr == argv[3] || format < 0 || format > 2) {
Tcl_AppendResult(interp, "Bad format",
argv[2], (char *)NULL);
return (TCL_ERROR);
}
if (format == 0 && mfile->hchunk.num_trks > 1) {
Tcl_AppendResult(interp, argv[1], " has too ",
"many tracks to be format 0", (char *)NULL);
return (TCL_ERROR);
}
mfile->hchunk.format = format;
if ((result = Tclm_SetMFile(interp, argv[1], mfile)) !=
TCL_OK)
return (result);
}
return (TCL_OK);
}
int
Tclm_Division(interp, argc, argv)
Tcl_Interp *interp;
int argc;
char **argv;
{
MIDI_FILE *mfile;
char *chk_ptr;
int division;
int result;
/*
* argv[0] - midiconfig
* argv[1] - mfileId
* argv[2] - division
* argv[3] - optional arg
*/
if ((result = Tclm_GetMFile(interp, argv[1], &mfile)) != TCL_OK)
return (result);
if (argc == 3)
sprintf(interp->result, "%d", mfile->hchunk.division);
else {
division = (int)strtol(argv[3], &chk_ptr, 0);
if (chk_ptr == argv[3]) {
Tcl_AppendResult(interp, "bad division value ",
argv[3], (char *)NULL);
return (TCL_ERROR);
}
mfile->hchunk.division = division;
if ((result = Tclm_SetMFile(interp, argv[1], mfile)) !=
TCL_OK)
return (result);
}
return (TCL_OK);
}
int
Tclm_MidiGet(foo, interp, argc, argv)
ClientData foo;
Tcl_Interp *interp;
int argc;
char **argv;
{
long timing;
char *chk_ptr;
unsigned char *event_ptr;
MIDI_FILE *mfile;
Tcl_Interp *temp_interp;
int channel;
int delta;
int denom;
int data_length;
int event_size;
int i;
int normal_type;
int result;
int track_num;
EVENT_TYPE event_type;
char dummy[MAX_EVENT_SIZE];
unsigned char event[MAX_EVENT_SIZE];
unsigned char running_state;
/*
* argv[0] - midiget
* argv[1] - mfileId
* argv[2] - track number
*/
if (argc != 3) {
Tcl_AppendResult(interp, "bad # args: should be \"",
argv[0], " mfileId track_num\"", (char *)NULL);
return (TCL_ERROR);
}
if ((result = Tclm_GetMFile(interp, argv[1], &mfile)) != TCL_OK)
return (result);
track_num = (int)strtol(argv[2], &chk_ptr, 0);
if (chk_ptr == argv[2] || track_num < 0 ||
track_num > mfile->hchunk.num_trks - 1) {
Tcl_AppendResult(interp, "Bad track number ", argv[2],
(char *)NULL);
return (TCL_ERROR);
}
if ((event_size = get_smf_event(&(mfile->tchunks[track_num]), event,
&event_type)) == -1) {
Tcl_AppendResult(interp, "Couldn't get event from ", argv[1],
" track ", argv[2], "\n", MidiError, (char *)NULL);
return (TCL_ERROR);
}
if (event_size == 0) {
Tcl_AppendResult(interp, "EOT", (char *)NULL);
return (TCL_OK);
}
/* get timing and skip over it */
event_ptr = event;
timing = var2fix(event_ptr, &delta);
sprintf(dummy, "%ld ", timing);
Tcl_AppendResult(interp, dummy, (char *)NULL);
event_ptr += delta;
event_size -= delta;
switch(event_type) {
case NORMAL:
if (event_ptr[0] & 0x80) {
running_state = event_ptr[0];
event_ptr++;
event_size--;
} else {
running_state =
get_running_state(&mfile->tchunks[track_num]);
}
normal_type = running_state & 0xf0;
channel = running_state & 0x0f;
switch(normal_type) {
case 0x80:
sprintf(dummy, "noteoff %d 0x%02x 0x%02x",
channel, event_ptr[0], event_ptr[1]);
Tcl_AppendResult(interp, dummy, (char *)NULL);
break;
case 0x90:
sprintf(dummy, "noteon %d 0x%02x 0x%02x",
channel, event_ptr[0], event_ptr[1]);
Tcl_AppendResult(interp, dummy, (char *)NULL);
break;
case 0xa0:
sprintf(dummy, "keypressure %d 0x%02x 0x%02x",
channel, event_ptr[0], event_ptr[1]);
Tcl_AppendResult(interp, dummy, (char *)NULL);
break;
case 0xb0:
sprintf(dummy, "parameter %d 0x%02x 0x%02x",
channel, event_ptr[0], event_ptr[1]);
Tcl_AppendResult(interp, dummy, (char *)NULL);
break;
case 0xc0:
sprintf(dummy, "program %d 0x%02x",
channel, event_ptr[0]);
Tcl_AppendResult(interp, dummy, (char *)NULL);
break;
case 0xd0:
sprintf(dummy, "channelpressure %d 0x%02x",
channel, event_ptr[0]);
Tcl_AppendResult(interp, dummy, (char *)NULL);
break;
case 0xe0:
sprintf(dummy, "pitchwheel %d 0x%04x",
channel, ((event_ptr[1] << 7) & 0x3f80) |
event_ptr[0]);
Tcl_AppendResult(interp, dummy, (char *)NULL);
break;
}
break;
case SYSEX:
Tcl_AppendResult(interp, "sysex ", (char *)NULL);
if (*event_ptr == 0xf7)
Tcl_AppendResult(interp, "cont ", (char *)NULL);
event_ptr++;
event_size--;
temp_interp = Tcl_CreateInterp();
data_length = var2fix(event_ptr, &delta);
for (i = 0; i < data_length; i++) {
sprintf(dummy, "0x%02x", event_ptr[delta + i]);
Tcl_AppendElement(temp_interp, dummy, 0);
}
Tcl_AppendElement(interp, temp_interp->result, 0);
Tcl_DeleteInterp(temp_interp);
break;
case METASEQNUM:
sprintf(dummy, "metaseqnum %d",
((event_ptr[3] << 8) & 0xff00) | (event_ptr[4] & 0xff));
Tcl_AppendResult(interp, dummy, (char *)NULL);
break;
case METATEXT:
Tcl_AppendResult(interp, "metatext ", (char *)NULL);
Tclm_MakeMetaText(interp, &event_ptr[2]);
break;
case METACPY:
Tcl_AppendResult(interp, "metacpy ", (char *)NULL);
Tclm_MakeMetaText(interp, &event_ptr[2]);
break;
case METASEQNAME:
Tcl_AppendResult(interp, "metaseqname ", (char *)NULL);
Tclm_MakeMetaText(interp, &event_ptr[2]);
break;
case METAINSTNAME:
Tcl_AppendResult(interp, "metainstname ", (char *)NULL);
Tclm_MakeMetaText(interp, &event_ptr[2]);
break;
case METALYRIC:
Tcl_AppendResult(interp, "metalyric ", (char *)NULL);
Tclm_MakeMetaText(interp, &event_ptr[2]);
break;
case METAMARKER:
Tcl_AppendResult(interp, "metamarker ", (char *)NULL);
Tclm_MakeMetaText(interp, &event_ptr[2]);
break;
case METACUE:
Tcl_AppendResult(interp, "metacue ", (char *)NULL);
Tclm_MakeMetaText(interp, &event_ptr[2]);
break;
case METACHANPREFIX:
temp_interp = Tcl_CreateInterp();
data_length = var2fix(&event_ptr[2], &delta);
for (i = 0; i < data_length; i++) {
sprintf(dummy, "0x%02x", event_ptr[2 + delta + i]);
Tcl_AppendElement(temp_interp, dummy, 0);
}
Tcl_AppendResult(interp, "metachanprefix {",
temp_interp->result, "}", (char *)NULL);
Tcl_DeleteInterp(temp_interp);
break;
case METAEOT:
Tcl_AppendResult(interp, "metaeot", (char *)NULL);
break;
case METATEMPO:
sprintf(dummy, "metatempo %d", 60000000 /
(event_ptr[3] * 0x10000 + event_ptr[4] * 0x100 +
event_ptr[5]));
Tcl_AppendResult(interp, dummy, (char *)NULL);
break;
case METASMPTE:
sprintf(dummy, "metasmpte %d %d %d %d %d", event_ptr[3],
event_ptr[4], event_ptr[5], event_ptr[6], event_ptr[7]);
Tcl_AppendResult(interp, dummy, (char *)NULL);
break;
case METATIME:
denom = 1;
for (i = 0; i < event_ptr[4]; i++)
denom *= 2;
sprintf(dummy, "metatime %d %d %d %d", event_ptr[3], denom,
event_ptr[5], event_ptr[6]);
Tcl_AppendResult(interp, dummy, (char *)NULL);
break;
case METAKEY:
Tcl_AppendResult(interp, "metakey \"",
key_strings[(int)event_ptr[3] + 7], "\" ",
(char *)NULL);
if (event_ptr[4] == 0)
Tcl_AppendResult(interp, "major", (char *)NULL);
else
Tcl_AppendResult(interp, "minor", (char *)NULL);
break;
case METASEQSPEC:
Tcl_AppendResult(interp, "metaseqspec", (char *)NULL);
break;
}
return (TCL_OK);
}
static void
Tclm_MakeMetaText(interp, event)
Tcl_Interp *interp;
unsigned char *event;
{
int data_length;
int delta;
int i;
char dummy[MAX_EVENT_SIZE];
data_length = var2fix(event, &delta);
for (i = 0; i < data_length; i++)
dummy[i] = event[delta + i];
dummy[i] = '\0';
Tcl_AppendResult(interp, "\"", dummy, "\"", (char *)NULL);
}
static int
Tclm_ConvertTiming(interp, str, timing, timing_length)
Tcl_Interp *interp;
char *str;
unsigned char *timing;
int *timing_length;
{
long time_long;
int i;
int num_bytes;
int result;
char *chk_ptr;
char **bytes_str;
if ((result = Tcl_SplitList(interp, str, &num_bytes, &bytes_str)) !=
TCL_OK)
return (result);
if (num_bytes == 1) {
time_long = strtol(bytes_str[0], &chk_ptr, 0);
if (bytes_str[0] == chk_ptr) {
Tcl_AppendResult(interp, "Bad timing value ",
bytes_str[0], (char *)NULL);
free((char *)bytes_str);
return (TCL_ERROR);
}
*timing_length = fix2var(time_long, timing);
} else {
for (i = 0; i < num_bytes; i++) {
timing[i] = (unsigned char)strtol(bytes_str[i],
&chk_ptr, 0);
if (chk_ptr == bytes_str[i]) {
Tcl_AppendResult(interp, "Bad timing data ",
bytes_str[i], (char *)NULL);
free((char *)bytes_str);
return (TCL_ERROR);
}
}
*timing_length = num_bytes;
}
free((char *)bytes_str);
return (TCL_OK);
}
static int
Tclm_ConvertBytes(interp, str, bytes, num_bytes)
Tcl_Interp *interp;
char *str;
unsigned char *bytes;
int *num_bytes;
{
int i;
int result;
char *chk_ptr;
char **bytes_str;
if ((result = Tcl_SplitList(interp, str, num_bytes, &bytes_str)) !=
TCL_OK)
return (result);
for (i = 0; i < *num_bytes; i++) {
*bytes++ = (unsigned char)strtol(bytes_str[i], &chk_ptr, 0);
if (chk_ptr == bytes_str[i]) {
Tcl_AppendResult(interp, "Bad event data ",
bytes_str[i], (char *)NULL);
free((char *)bytes_str);
return (TCL_ERROR);
}
}
free((char *)bytes_str);
return (TCL_OK);
}
int
Tclm_MidiPut(dummy, interp, argc, argv)
ClientData dummy;
Tcl_Interp *interp;
int argc;
char **argv;
{
char *chk_ptr;
char *event_name;
char *event_ptr;
MIDI_FILE *mfile;
int bad_event;
int i;
int length;
int num_bytes;
int result;
int timing_length;
int track_num;
unsigned char timing[4];
unsigned char event[MAX_EVENT_SIZE];
/*
* argv[0] - midiput
* argv[1] - mfileId
* argv[2] - track number
* argv[3] - timing
* argv[4] - event name
* argv[5] - event specific data
* argv[6] -
* etc.
*/
if (argc < 5) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
"midiput mfileId track timing eventname ?args ...?\"",
(char *)NULL);
return (TCL_ERROR);
}
if ((result = Tclm_GetMFile(interp, argv[1], &mfile)) != TCL_OK)
return (result);
track_num = (int)strtol(argv[2], &chk_ptr, 0);
if (chk_ptr == argv[2] || track_num < 0 ||
track_num > mfile->hchunk.num_trks - 1) {
Tcl_AppendResult(interp, "Bad track number ", argv[2],
(char *)NULL);
return (TCL_ERROR);
}
if ((result = Tclm_ConvertTiming(interp, argv[3], timing,
&timing_length)) != TCL_OK)
return (result);
for (i = 0; i < timing_length; i++)
event[i] = timing[i];
num_bytes = timing_length;
/* do different things depending on the event type */
event_name = argv[4];
length = strlen(event_name);
bad_event = 0;
switch(event_name[0]) {
case 'c':
if (strncmp(event_name, "channelpressure", length) != 0)
bad_event = 1;
else {
/*
* argv[5] - channel
* argv[6] - pressure
*/
unsigned char channel;
unsigned char pressure;
if (argc != 7) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be \"midiput mfileId track ",
"timing channelpressure channel ",
"pressure\"", (char *)NULL);
return (TCL_ERROR);
}
channel = (unsigned char)strtol(argv[5], &chk_ptr, 0);
if (chk_ptr == argv[5] || channel & 0x80) {
Tcl_AppendResult(interp, "bad channel ",
argv[5], (char *)NULL);
return (TCL_ERROR);
}
pressure = (unsigned char)strtol(argv[6], &chk_ptr, 0);
if (chk_ptr == argv[6] || pressure & 0x80) {
Tcl_AppendResult(interp, "bad pressure ",
argv[6], (char *)NULL);
return (TCL_ERROR);
}
event[num_bytes++] = 0xd0 + channel;
event[num_bytes++] = pressure;
}
break;
case 'k':
if (strncmp(event_name, "keypressure", length) != 0)
bad_event = 1;
else {
/*
* argv[5] - channel
* argv[6] - pitch
* argv[7] - pressure
*/
unsigned char channel;
unsigned char pitch;
unsigned char pressure;
if (argc != 8) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be \"midiput mfileId track ",
"timing keypressure channel ",
"pitch pressure\"", (char *)NULL);
return (TCL_ERROR);
}
channel = (unsigned char)strtol(argv[5], &chk_ptr, 0);
if (chk_ptr == argv[5] || channel & 0x80) {
Tcl_AppendResult(interp, "bad channel ",
argv[5], (char *)NULL);
return (TCL_ERROR);
}
pitch = (unsigned char)strtol(argv[6], &chk_ptr, 0);
if (chk_ptr == argv[6] || pitch & 0x80) {
Tcl_AppendResult(interp, "bad pitch ",
argv[6], (char *)NULL);
return (TCL_ERROR);
}
pressure = (unsigned char)strtol(argv[7], &chk_ptr, 0);
if (chk_ptr == argv[7] || pressure & 0x80) {
Tcl_AppendResult(interp, "bad pressure ",
argv[7], (char *)NULL);
return (TCL_ERROR);
}
event[num_bytes++] = 0xa0 + channel;
event[num_bytes++] = pitch;
event[num_bytes++] = pressure;
}
break;
case 'm':
/* META stuff */
if ((result = Tclm_ConvertMeta(interp, argc - 4, argv + 4,
event, &num_bytes)) != TCL_OK)
return (result);
break;
case 'n':
if (strncmp(event_name, "noteoff", length) == 0 ||
strncmp(event_name, "noteon", length) == 0) {
/*
* argv[5] - channel
* argv[6] - pitch
* argv[7] - velocity
*/
unsigned char channel;
unsigned char pitch;
unsigned char velocity;
if (event_name[5] == 'n') {
if (argc != 8) {
Tcl_AppendResult(interp, "wrong #",
"args: should be \"midiput ",
"mfileId track timing noteon ",
"channel pitch velocity\"",
(char *)NULL);
return (TCL_ERROR);
}
} else {
if (argc != 7 && argc != 8) {
Tcl_AppendResult(interp, "wrong #",
"args: should be \"midiput ",
"mfileId track timing noteoff ",
"channel pitch ?velocity?\"",
(char *)NULL);
return (TCL_ERROR);
}
}
channel = (unsigned char)strtol(argv[5], &chk_ptr, 0);
if (chk_ptr == argv[5] || channel & 0x80) {
Tcl_AppendResult(interp, "bad channel ",
argv[5], (char *)NULL);
return (TCL_ERROR);
}
pitch = (unsigned char)strtol(argv[6], &chk_ptr, 0);
if (chk_ptr == argv[6] || pitch & 0x80) {
Tcl_AppendResult(interp, "bad pitch ",
argv[6], (char *)NULL);
return (TCL_ERROR);
}
if (argc == 8) {
velocity = (unsigned char)strtol(argv[7],
&chk_ptr, 0);
if (chk_ptr == argv[7] || velocity & 0x80) {
Tcl_AppendResult(interp, "bad ",
"velocity ", argv[7],
(char *)NULL);
return (TCL_ERROR);
}
} else {
velocity = 0;
}
/*
* if noteoff velocity is zero use noteon
* This will make better use of running state
*/
if (event_name[5] == 'f' && velocity != 0)
event[num_bytes++] = 0x80 + channel;
else
event[num_bytes++] = 0x90 + channel;
event[num_bytes++] = pitch;
event[num_bytes++] = velocity;
} else
bad_event = 1;
break;
case 'p':
if (strncmp(event_name, "parameter", length) == 0) {
/*
* argv[5] - channel
* argv[6] - param
* argv[7] - setting
*/
unsigned char channel;
unsigned char param;
unsigned char setting;
if (argc != 8) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be \"midiput mfileId track ",
"timing parameter channel ",
"param setting\"", (char *)NULL);
return (TCL_ERROR);
}
channel = (unsigned char)strtol(argv[5], &chk_ptr, 0);
if (chk_ptr == argv[5] || channel & 0x80) {
Tcl_AppendResult(interp, "bad channel ",
argv[5], (char *)NULL);
return (TCL_ERROR);
}
param = (unsigned char)strtol(argv[6], &chk_ptr, 0);
if (chk_ptr == argv[6] || param & 0x80) {
Tcl_AppendResult(interp, "bad parameter ",
argv[6], (char *)NULL);
return (TCL_ERROR);
}
setting = (unsigned char)strtol(argv[7], &chk_ptr, 0);
if (chk_ptr == argv[7] || setting & 0x80) {
Tcl_AppendResult(interp, "bad setting ",
argv[7], (char *)NULL);
return (TCL_ERROR);
}
event[num_bytes++] = 0xb0 + channel;
event[num_bytes++] = param;
event[num_bytes++] = setting;
} else if (strncmp(event_name, "pitchwheel", length) == 0) {
/*
* argv[5] - channel
* argv[6] - value
*/
int value;
unsigned char channel;
if (argc != 7) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be \"midiput mfileId track ",
"timing pitchwheel channel value\"",
(char *)NULL);
return (TCL_ERROR);
}
channel = (unsigned char)strtol(argv[5], &chk_ptr, 0);
if (chk_ptr == argv[5] || channel & 0x80) {
Tcl_AppendResult(interp, "bad channel ",
argv[5], (char *)NULL);
return (TCL_ERROR);
}
value = (int)strtol(argv[6], &chk_ptr, 0);
if (chk_ptr == argv[6]) {
Tcl_AppendResult(interp, "bad wheel value ",
argv[6], (char *)NULL);
return (TCL_ERROR);
}
event[num_bytes++] = 0xe0 + channel;
event[num_bytes++] = value & 0x7f;
event[num_bytes++] = (value >> 7) & 0x7f;
} else if (strncmp(event_name, "program", length) == 0) {
/*
* argv[5] - channel
* argv[6] - program
*/
unsigned char channel;
unsigned char program;
if (argc != 7) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be \"midiput mfileId track ",
"timing program channel program\"",
(char *)NULL);
return (TCL_ERROR);
}
channel = (unsigned char)strtol(argv[5], &chk_ptr, 0);
if (chk_ptr == argv[5] || channel & 0x80) {
Tcl_AppendResult(interp, "bad channel ",
argv[5], (char *)NULL);
return (TCL_ERROR);
}
program = (unsigned char)strtol(argv[6], &chk_ptr, 0);
if (chk_ptr == argv[6] || program & 0x80) {
Tcl_AppendResult(interp, "bad program ",
argv[6], (char *)NULL);
return (TCL_ERROR);
}
event[num_bytes++] = 0xc0 + channel;
event[num_bytes++] = program;
} else
bad_event = 1;
break;
case 's':
/* SYSEX */
/*
* argv[5] - ?cont? or sysex bytes
* argv[6] - ?sysex bytes?
*/
if (strncmp(event_name, "sysex", length) != 0)
bad_event = 1;
else {
if (argc != 6 && argc != 7) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be \"midiput mfileId track ",
"timing sysex ?cont? data\"", (char *)NULL);
return (TCL_ERROR);
}
if (strcmp(argv[5], "cont") == 0) {
event[num_bytes++] = 0xf7;
event_ptr = argv[6];
} else {
event[num_bytes++] = 0xf0;
event_ptr = argv[5];
}
if ((result = Tclm_AddMetaBytes(interp, event,
&num_bytes, event_ptr)) != TCL_OK)
return (result);
}
break;
}
if (bad_event) {
Tcl_AppendResult(interp, "Bad event. Must be one of (",
event_list, ")", (char *)NULL);
return(TCL_ERROR);
}
if (!put_smf_event(&(mfile->tchunks[track_num]), event, num_bytes)) {
Tcl_AppendResult(interp, "Couldn't put event\n",
MidiError, (char *)NULL);
return (TCL_ERROR);
}
return (TCL_OK);
}
static int
Tclm_ConvertMeta(interp, argc, argv, event, num_bytes)
Tcl_Interp *interp;
int argc;
char **argv;
unsigned char *event;
int *num_bytes;
{
char *chk_ptr;
char *event_name;
int bad_meta_event;
int i;
int length;
int result;
/*
* argv[0] - metablah
* argv[1] - args
*/
event_name = argv[0];
if (strncmp(event_name, "meta", 4) != 0) {
Tcl_AppendResult(interp, "bad event type ", argv[0],
(char *)NULL);
return (TCL_ERROR);
}
event_name += 4;
/* all meta events start with 0xff */
event[(*num_bytes)++] = 0xff;
length = strlen(event_name);
bad_meta_event = 0;
switch (event_name[0]) {
case 'c':
if (strncmp(event_name, "chanprefix", length) == 0) {
/*
* argv[1] - bytes
*/
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be: \"midiput mfileId track ",
"timing metachanprefix data\"",
(char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = 0x20;
if ((result = Tclm_AddMetaBytes(interp, event,
num_bytes, argv[1])) != TCL_OK)
return (result);
} else if (strncmp(event_name, "cpy", length) == 0) {
/*
* argv[1] - copyright string
*/
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be: \"midiput mfileId track ",
"timing metacpy copyright\"",
(char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = 0x02;
Tclm_AddMetaString(event, num_bytes, argv[1]);
} else if (strncmp(event_name, "cue", length) == 0) {
/*
* argv[1] - cue string
*/
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be: \"midiput mfileId track ",
"timing metacue cue\"",
(char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = 0x07;
Tclm_AddMetaString(event, num_bytes, argv[1]);
} else
bad_meta_event = 1;
break;
case 'e':
if (strncmp(event_name, "eot", length) != 0)
bad_meta_event = 1;
else {
if (argc != 1) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be: \"midiput mfileId track ",
"timing metaeot\"",
(char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = 0x2f;
event[(*num_bytes)++] = 0x00;
}
break;
case 'i':
if (strncmp(event_name, "instname", length) != 0)
bad_meta_event = 1;
else {
/*
* argv[1] - instrument string
*/
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be: \"midiput mfileId track ",
"timing metainstname instrument\"",
(char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = 0x04;
Tclm_AddMetaString(event, num_bytes, argv[1]);
}
break;
case 'k':
if (strncmp(event_name, "key", length) != 0)
bad_meta_event = 1;
else {
int bad_key;
/*
* argv[1] - key name
* argv[2] - key class
*/
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be: \"midiput mfileId track ",
"timing metakey key class\"",
(char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = 0x59;
event[(*num_bytes)++] = 2;
bad_key = 0;
switch (argv[1][0]) {
case 'A':
if (strcmp(argv[1], "A") == 0)
event[(*num_bytes)++] = 3;
else if (strcmp(argv[1], "A flat") == 0)
event[(*num_bytes)++] =
(unsigned char)-4;
else
bad_key = 1;
break;
case 'B':
if (strcmp(argv[1], "B") == 0)
event[(*num_bytes)++] = 5;
else if (strcmp(argv[1], "B flat") == 0)
event[(*num_bytes)++] =
(unsigned char)-2;
else
bad_key = 1;
break;
case 'C':
if (strcmp(argv[1], "C") == 0)
event[(*num_bytes)++] = 0;
else if (strcmp(argv[1], "C flat") == 0)
event[(*num_bytes)++] =
(unsigned char)-7;
else if (strcmp(argv[1], "C sharp") == 0)
event[(*num_bytes)++] = 7;
else
bad_key = 1;
break;
case 'D':
if (strcmp(argv[1], "D") == 0)
event[(*num_bytes)++] = 2;
else if (strcmp(argv[1], "D flat") == 0)
event[(*num_bytes)++] =
(unsigned char)-5;
else
bad_key = 1;
break;
case 'E':
if (strcmp(argv[1], "E") == 0)
event[(*num_bytes)++] = 4;
else if (strcmp(argv[1], "E flat") == 0)
event[(*num_bytes)++] =
(unsigned char)-3;
else
bad_key = 1;
break;
case 'F':
if (strcmp(argv[1], "F") == 0)
event[(*num_bytes)++] =
(unsigned char)-1;
else if (strcmp(argv[1], "F sharp") == 0)
event[(*num_bytes)++] = 6;
else
bad_key = 1;
break;
case 'G':
if (strcmp(argv[1], "G") == 0)
event[(*num_bytes)++] = 1;
else if (strcmp(argv[1], "G flat") == 0)
event[(*num_bytes)++] =
(unsigned char)-6;
else
bad_key = 1;
break;
default:
bad_key = 1;
}
if (bad_key) {
Tcl_AppendResult(interp, "Bad key. Must ",
"be one of: ", (char *)NULL);
for (i = 0; i < sizeof(key_strings) /
sizeof(key_strings[0]); i++)
Tcl_AppendResult(interp, "\"",
key_strings[i], "\" ",
(char *)NULL);
return (TCL_ERROR);
}
if (strcmp(argv[2], "major") == 0)
event[(*num_bytes)++] = 0;
else if (strcmp(argv[2], "minor") == 0)
event[(*num_bytes)++] = 1;
else {
Tcl_AppendResult(interp, "Bad key class. ",
"Must be one of: \"major\" \"minor\"",
(char *)NULL);
return (TCL_ERROR);
}
}
break;
case 'l':
if (strncmp(event_name, "lyric", length) != 0)
bad_meta_event = 1;
else {
/*
* argv[1] - lyric string
*/
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be: \"midiput mfileId track ",
"timing metalyric lyric\"",
(char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = 0x05;
Tclm_AddMetaString(event, num_bytes, argv[1]);
}
break;
case 'm':
if (strncmp(event_name, "marker", length) != 0)
bad_meta_event = 1;
else {
/*
* argv[1] - marker string
*/
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be: \"midiput mfileId track ",
"timing metachanprefix marker\"",
(char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = 0x06;
Tclm_AddMetaString(event, num_bytes, argv[1]);
}
break;
case 's':
if (strncmp(event_name, "seqname", length) == 0) {
/*
* argv[1] - sequence name string
*/
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be: \"midiput mfileId track ",
"timing metaseqname sequencename\"",
(char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = 0x03;
Tclm_AddMetaString(event, num_bytes, argv[1]);
} else if (strncmp(event_name, "seqnum", length) == 0) {
int number;
/*
* argv[1] - sequence number
*/
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be: \"midiput mfileId track ",
"timing metaseqnum sequencenumber\"",
(char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = 0x00;
event[(*num_bytes)++] = 0x02;
number = (int)strtol(argv[1], &chk_ptr, 0);
if (argv[1] == chk_ptr) {
Tcl_AppendResult(interp, "Bad sequence number ",
argv[1], (char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = (number >> 8) & 0xff;
event[(*num_bytes)++] = number & 0xff;
} else if (strncmp(event_name, "seqspec", length) == 0) {
Tcl_AppendResult(interp, "META event seqspec not ",
"currently implemented (don't know form)",
(char *)NULL);
return (TCL_ERROR);
} else if (strncmp(event_name, "smpte", length) == 0) {
/*
* argv[1] - hour
* argv[2] - minute
* argv[3] - second
* argv[4] - frame
* argv[5] - fractional frame
*/
if (argc != 6) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be: \"midiput mfileId track ",
"timing metasmpte hour minute second",
"frame fractionalframe\"",
(char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = 0x54;
event[(*num_bytes)++] = 5;
event[(*num_bytes)++] = (unsigned char)strtol(argv[1],
&chk_ptr, 0);
if (argv[1] == chk_ptr) {
Tcl_AppendResult(interp, "Bad SMPTE hour: ",
argv[1], (char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = (unsigned char)strtol(argv[2],
&chk_ptr, 0);
if (argv[2] == chk_ptr) {
Tcl_AppendResult(interp, "Bad SMPTE minute: ",
argv[2], (char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = (unsigned char)strtol(argv[3],
&chk_ptr, 0);
if (argv[3] == chk_ptr) {
Tcl_AppendResult(interp, "Bad SMPTE second: ",
argv[3], (char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = (unsigned char)strtol(argv[4],
&chk_ptr, 0);
if (argv[4] == chk_ptr) {
Tcl_AppendResult(interp, "Bad SMPTE frame: ",
argv[4], (char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = (unsigned char)strtol(argv[5],
&chk_ptr, 0);
if (argv[5] == chk_ptr) {
Tcl_AppendResult(interp, "Bad SMPTE ",
"fractional frame: ", argv[5],
(char *)NULL);
return (TCL_ERROR);
}
} else
bad_meta_event = 1;
break;
case 't':
if (strncmp(event_name, "tempo", length) == 0) {
long tempo;
int is_bpm;
int tempo_length;
char tempo_str[20];
/*
* argv[1] - usec/beat or beat/min
*/
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be: \"midiput mfileId track ",
"timing metachanprefix tempo\"",
(char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = 0x51;
event[(*num_bytes)++] = 3;
strcpy(tempo_str, argv[1]);
tempo_length = strlen(tempo_str);
if (tempo_str[tempo_length - 1] != 'u')
is_bpm = 1;
else {
/* in usec/beat */
tempo_str[tempo_length - 1] = '\0';
is_bpm = 0;
}
tempo = strtol(tempo_str, &chk_ptr, 0);
if (tempo_str == chk_ptr) {
Tcl_AppendResult(interp, "Bad tempo value: ",
argv[1], (char *)NULL);
return (TCL_ERROR);
}
if (is_bpm)
tempo = 60000000 / tempo;
event[(*num_bytes)++] = tempo / 0x10000;
tempo %= 0x10000;
event[(*num_bytes)++] = tempo / 0x100;
tempo %= 0x100;
event[(*num_bytes)++] = tempo;
} else if (strncmp(event_name, "text", length) == 0) {
/*
* argv[1] - text string
*/
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be: \"midiput mfileId track ",
"timing metatext text\"",
(char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = 0x01;
Tclm_AddMetaString(event, num_bytes, argv[1]);
} else if (strncmp(event_name, "time", length) == 0) {
int denominator;
int pow;
/*
* argv[1] - numerator
* argv[2] - denominator (in - powers of 2)
* argv[3] - clocks / met. beat
* argv[4] - 32nd notes / quarter notes
*/
if (argc != 5) {
Tcl_AppendResult(interp, "wrong # args: ",
"should be: \"midiput mfileId track ",
"timing metatime numerator denominator",
"clockspermet 32ndsperquarter\"",
(char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = 0x58;
event[(*num_bytes)++] = 4;
event[(*num_bytes)++] = (unsigned char)strtol(argv[1],
&chk_ptr, 0);
if (chk_ptr == argv[1]) {
Tcl_AppendResult(interp, "Bad numerator: ",
argv[1], (char *)NULL);
return (TCL_ERROR);
}
denominator = (unsigned char)strtol(argv[2],
&chk_ptr, 0);
if (chk_ptr == argv[2]) {
Tcl_AppendResult(interp, "Bad denominator: ",
argv[2], (char *)NULL);
return (TCL_ERROR);
}
for (i = 0, pow = 1; pow <= denominator; pow *= 2, i++);
i--;
event[(*num_bytes)++] = (unsigned char)i;
event[(*num_bytes)++] = (unsigned char)strtol(argv[3],
&chk_ptr, 0);
if (chk_ptr == argv[3]) {
Tcl_AppendResult(interp, "Bad numerator: ",
argv[3], (char *)NULL);
return (TCL_ERROR);
}
event[(*num_bytes)++] = (unsigned char)strtol(argv[4],
&chk_ptr, 0);
if (chk_ptr == argv[4]) {
Tcl_AppendResult(interp, "Bad numerator: ",
argv[4], (char *)NULL);
return (TCL_ERROR);
}
} else
bad_meta_event = 1;
break;
}
if (bad_meta_event) {
Tcl_AppendResult(interp, "Bad META event: meta", event_name,
". Must be one of (", meta_events, ")", (char *)NULL);
return (TCL_ERROR);
}
return (TCL_OK);
}
static void
Tclm_AddMetaString(event, num_bytes, str)
unsigned char *event;
int *num_bytes;
char *str;
{
int i;
int str_len;
int var_len;
unsigned char var_bytes[10];
str_len = strlen(str);
var_len = fix2var(str_len, var_bytes);
for (i = 0; i < var_len; i++)
event[(*num_bytes)++] = var_bytes[i];
for (i = 0; i < str_len; i++)
event[(*num_bytes)++] = str[i];
}
static int
Tclm_AddMetaBytes(interp, event, num_bytes, data)
Tcl_Interp *interp;
unsigned char *event;
int *num_bytes;
char *data;
{
int i;
int result;
int num_data_bytes;
int var_len;
unsigned char data_bytes[MAX_EVENT_SIZE];
unsigned char var_bytes[10];
if ((result = Tclm_ConvertBytes(interp, data, data_bytes,
&num_data_bytes)) != TCL_OK)
return (result);
var_len = fix2var(num_data_bytes, var_bytes);
for (i = 0; i < var_len; i++)
event[(*num_bytes)++] = var_bytes[i];
for (i = 0; i < num_data_bytes; i++)
event[(*num_bytes)++] = data_bytes[i];
return (TCL_OK);
}
int
Tclm_MidiRewind(dummy, interp, argc, argv)
ClientData dummy;
Tcl_Interp *interp;
int argc;
char **argv;
{
MIDI_FILE *mfile;
char *chk_ptr;
char **track_list;
int i;
int num_tracks;
int result;
int track;
/*
* argv[0] - midirewind
* argv[1] = mfileId
* argv[2] = optional track list
*/
if (argc < 2 || argc > 3) {
Tcl_AppendResult(interp, "bad # args: should be \"",
argv[0], " mfileId ?track list?\"", (char *)NULL);
return (TCL_ERROR);
}
if ((result = Tclm_GetMFile(interp, argv[1], &mfile)) != TCL_OK)
return (result);
if (argc == 2)
for (i = 0; i < mfile->hchunk.num_trks; i++)
rewind_track(&(mfile->tchunks[i]));
else {
if ((result = Tcl_SplitList(interp, argv[2], &num_tracks,
&track_list)) != TCL_OK)
return (result);
for (i = 0; i < num_tracks; i++) {
track = (int)strtol(track_list[i], &chk_ptr, 0);
if (chk_ptr == track_list[i] || track < 0 ||
track >= mfile->hchunk.num_trks) {
Tcl_AppendResult(interp, "Bad track value ",
track_list[i], (char *)NULL);
free ((char *)track_list);
return (TCL_ERROR);
}
rewind_track(&(mfile->tchunks[track]));
}
free((char *)track_list);
}
return (TCL_OK);
}
int
Tclm_MidiVarToFix(dummy, interp, argc, argv)
ClientData dummy;
Tcl_Interp *interp;
int argc;
char **argv;
{
long fix;
int delta;
int num_bytes;
int result;
unsigned char bytes[MAX_EVENT_SIZE];
/*
* argv[0] - midivartofix
* argv[1] - midi event
*/
if (argc != 2) {
Tcl_AppendResult(interp, "bad # args: should be\"",
argv[0], " midi_event\"", (char *)NULL);
return (TCL_ERROR);
}
if ((result = Tclm_ConvertBytes(interp, argv[1], bytes, &num_bytes))
!= TCL_OK)
return (result);
fix = var2fix(bytes, &delta);
sprintf(interp->result, "%ld", fix);
return (TCL_OK);
}
int
Tclm_MidiFixToVar(dummy, interp, argc, argv)
ClientData dummy;
Tcl_Interp *interp;
int argc;
char **argv;
{
long fix;
char *chk_ptr;
int i;
int num_bytes;
unsigned char bytes[4];
char byte_str[10];
/*
* argv[0] - midifixtovar
* argv[1] - fixed length value
*/
if (argc != 2) {
Tcl_AppendResult(interp, "bad # args: should be \"",
argv[0], " fixval\"", (char *)NULL);
return (TCL_ERROR);
}
fix = strtol(argv[1], &chk_ptr, 0);
if (chk_ptr == argv[1]) {
Tcl_AppendResult(interp, "Bad fixed length value ", argv[1],
(char *)NULL);
return (TCL_ERROR);
}
num_bytes = fix2var(fix, bytes);
for (i = 0; i < num_bytes; i++) {
sprintf(byte_str, "0x%02x", bytes[i]);
Tcl_AppendElement(interp, byte_str, 0);
}
return (TCL_OK);
}
int
Tclm_MidiTiming(dummy, interp, argc, argv)
ClientData dummy;
Tcl_Interp *interp;
int argc;
char **argv;
{
int delta;
int i;
int num_bytes;
int result;
unsigned char bytes[MAX_EVENT_SIZE];
char str[10];
/*
* argv[0] - miditiming
* argv[1] - event
*/
if ((result = Tclm_ConvertBytes(interp, argv[1], bytes, &num_bytes))
!= TCL_OK)
return (result);
(void)var2fix(bytes, &delta);
for (i = 0; i < delta; i++) {
sprintf(str, "0x%02x", bytes[i]);
Tcl_AppendElement(interp, str, 0);
}
return (TCL_OK);
}
int
Tclm_MidiPlayable(dummy, interp, argc, argv)
ClientData dummy;
Tcl_Interp *interp;
int argc;
char **argv;
{
/*
* argv[0] - midiplayable
*/
if (argc != 1) {
Tcl_AppendResult(interp, "wrong # args: should be\"",
argv[0], "\"", (char *)NULL);
return (TCL_ERROR);
}
#ifdef MIDIPLAY
Tcl_AppendResult(interp, "1", (char *)NULL);
#else
Tcl_AppendResult(interp, "0", (char *)NULL);
#endif
return (TCL_OK);
}
int
Tclm_TclmVersion(dummy, interp, argc, argv)
ClientData dummy;
Tcl_Interp *interp;
int argc;
char **argv;
{
/*
* argv[0] - tclmversion
*/
if (argc != 1) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], "\"", (char *)NULL);
return (TCL_ERROR);
}
Tcl_AppendResult(interp, TCLM_PATCHLEVEL, (char *)NULL);
return (TCL_OK);
}